C   HOMX, LULOOP, ZCRSOR, HELP, ORDER, DPYX, FILX, RREAD, NUMZ
C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
	SUBROUTINE HOMX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW
	1 /POSI/STFF(0/7),JJ2,POS /LIMIT/LIMIT,ITEM,L,I,IX
	2 /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1) /PTR/PWDS(1)
	3 /ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
	EQUIVALENCE (R3,RJQ(1)),(R7,RJQ(5)),(R9,RJQ(7))
	1,(R4,RJQ(2)),(R8,RJQ(6)),(R5,RJQ(3)),(R10,RJQ(8))
	
	JJ2=1000
C  THE STAFF # =R2
	DO 110 K=1,ITEM
	IF(CODN(K,L).NE.6)GO TO 110
C RETURNS POINTER IN L
C%%%%%%%%%%%
	IF(R2.GT.7)GO TO 10
C  J2=STAFF #.  >7 = ALL STAVES.
	IF(RN(L+2).NE.R2)GO TO 110
10	R7=RN(L+7)
	IF(R7)GO TO 110
C SKIP TREMOLO AND UNATTACHED PARTIAL BEAMS.
	RS=RN(L+2)
C STAFF OF THIS BEAM
	ISD=IFIX(R7/10.)
C STEM DIRECTION. 1=UP  2=DOWN
	RM=RSTFAC(IFIX(RS))
	RSTJ2=RM
C SIZE FACTOR
	RL=RN(L+3)
	RR=RN(L+6)
C OVERALL LEFT-RIGHT LIMITS
	PL=RL
	PR=RR
C LEFT-RIGHT POS. TO BE USED
	RLH=RN(L+4)
	RRH=RN(L+5)
C LEFT-RIGHT HEIGHTS
	RMIN=1.
	MIN=-1
C  FLAG FOR MINI-NOTES AND BEAMS
	W=ABS(RLH)
	IF(W.LE.80)GO TO 20
CCC     IF(W.GE.180)GO TO 3
C SKIP IF X NOTES, DIAMONDS, NO NOTE HEAD
	MIN=0
	RMIN=.6
	RM=RM*.6
C MINI SIZE FACTOR
	RLH=ABS(RLH)-100.
20	WC=RN(L)
C  WORD COUNT
	T=-1
	IF(RN(L+10).GE.100)GO TO 30
C P10=100 ETC. =COMPOSITE BEAM WITH AT LEAST 1 COMPLETE ONE.
	IF(WC.LT.6)GO TO 30
	R8=RN(L+8)
	IF(R8.EQ.0)GO TO 30
	IF(R8)GO TO 110
	IF(WC.LT.7)GO TO 30
	R9=RN(L+9)
	IF(R9.EQ.0)GO TO 30
	PL=R8
	PR=R9
C  POS. OF INNER PARTIAL BEAM.
	IF(WC.LT.8)GO TO 30
	IF(RN(L+10).GT.0)T=RN(L+10)+T
30	IR7=AMOD(R7,10.0)+T
C NUMBER OF BEAMS
	PL=PL-.1
	PR=PR+.1
C FOR ROUND-OFF ERROR
	T=RR-RL
C  TOTAL LENGTH OF FULL BEAM
	TH=RRH-RLH
C  TOTAL HEIGHT
	T=TH/T
C FACTOR

	DO 100 J=1,ITEM
	IF(CODN(J,L).NE.1)GO TO 100
	IF(RN(L+2).NE.RS)GO TO 100
C SKIP IF NOT ON RIGHT STAFF
	R5=RN(L+5)
	IF(R5.LT.10)GO TO 100
C SKIP IF NO STEM ON NOTE
	R3=RN(L+3)
	IXD=0
CW      A=0
	IF(IFIX(R5/10.).EQ.ISD)GO TO 40
C A IS FOR HORZ. DISPLACEMENT DUE TO OPPOSITE STEM DIRECTIONS.
	IXD=-1
	A=RNW*RM
C  A=WIDTH OF NOTE*SIZE FACTOR   + OR -    RNW=WIDTH OF A NOTE(2.44)
	IF(ISD.EQ.1)A=-A
	R3=A+R3
40	IF(R3.LT.PL)GO TO 100
	IF(R3.GT.PR)GO TO 100
C SKIP IF NOT IN BOUNDS OF BEAM SEGMENT.
CW      R3=A+R3
	R4=RN(L+4)
	R4X=ABS(R4)
	R4=AMOD(R4,100.0)
	IF(R4X.LE.80)GO TO 50
	IF(R4X.GE.180)GO TO 50
	IF(MIN)GO TO 100
C NOW MINI-NOTE
CC      R4=ABS(R4)-100.
	IF(R4.GT.80.)R4=R4-100.
C MINIS MAY GO FROM 81 TO 179.  NUMS < 100 ARE CONVERTED TO NUM-100.
	GO TO 60
50	IF(MIN.EQ.0)GO TO 100
CC      R4=AMOD(R4,100.0)
CATCH DIAMONDS, X NOTES, HEADLESS NOTES.
60	R6=T*(R3-RL)
	R8=RLH+R6-R4
C ADJUSTED STEM LENGTH
	IF(ISD.EQ.2)R8=-R8
	IF(IXD.EQ.0)GO TO 70
	R9=(IR7*1.571429-13.714)*RMIN
	R8=-R8
70	IF(RN(L).LT.8)GO TO 90
CHECK P10 FOR STAFF CHANGE FLAG
	R10=RN(L+10)
	IF(R10.LE.0)GO TO 90
	N=-1
	IF(R10.EQ.2)N=-N
C N =-1 = ON STAFF BELOW, =1 = ABOVE.
	M=RS
	R3=ABS((STFF(M+N)-STFF(M))/(RSTJ2*7))
	IF(IXD)GO TO 80
	IF(R10.NE.ISD)R3=-R3
C ABOVE FOR STEMS SAME DIR, STAFF CHNG IN SAME DIR.
80	R8=R8+R3
C ADDS DISTANCE TO OTHER STAFF - CONVERTED TO NOTE NUMBERS.
90	IF(IXD)R8=R8+R9
C IF OPPOSITE STEM DIR., SUBTRACT (2*STEM AND EXTRA BEAM SPACE)*SIZE
	IF(R8.LT.-5)GO TO 100
C AFTER ALL THAT, IF BEAM IS TOO SMALL THEN IGNORE IT.
	IF(JJ2.GT.J)JJ2=J
C  POINT TO 1ST ITEM TO RE-DISPLAY
	RN(L+8)=R8
	R7=RN(L+7)
C NEXT DELETES TAILS
	IF(R7.EQ.0)GO TO 100
	N=AMOD(R7,10.)
	RN(L+7)=R7-N
100	CONTINUE
110	CONTINUE
	IF(JJ2.EQ.1000)JJ2=-1
	END

	SUBROUTINE SHRINK(JIT)
	COMMON /XRN/RN(1) /PTR/KWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX
	1 /ALF/A,B,C,K,M,N,MM
	IF(JIT.EQ.0)JIT=1
	MM=I
	DO 40 K=ITEM,JIT,-1
	L=KWDS(K)
	M=RN(L)
	IF(M.LE.2)GO TO 40
	J=M+2+L
	IF(RN(L+1).NE.1)GO TO 10
	IF(RN(L+8).EQ.0)RN(L+8)=999
C  NOTES MUST HAVE AT LEAST 8 PARAMS.
10	DO 20 N=J,L,-1
20	IF(RN(N).NE.0)GO TO 30
	GO TO 40
30	IF(N.EQ.J)GO TO 40
	M=I-N
	CALL RLOOP(RN(N+1),RN(J+1),M)
	MM=J-N
	RN(L)=RN(L)-MM
C RESET THE WDCNT.
	I=I-MM
40	CONTINUE
	L=KWDS(JIT)
50	JIT=JIT+1
	L=RN(L)+3+L
C  POINTER TO NEXT ITEM
	KWDS(JIT)=L
	IF(JIT.LE.ITEM)GO TO 50
	END

	SUBROUTINE LULOOP
	COMMON /ALF/ INP(1)
	ICOM=0
	DO 10 K=1,72
	IF(ICOM.LT.0)INP(K)=' '
	J=INP(K)
	IF(J.NE.'<')GO TO 1
	INP(K)=' '
	ICOM=-1
	GO TO 10
C USE '<' FOR COMMENTS.  IGNORES REST OF LINE.
1	IF(J.EQ.' ')GO TO 10
	INP(K)=J.AND..NOT.((J/2).AND."201004020100)
10	CONTINUE
	END

	SUBROUTINE ZCRSOR
	COMMON R2,JA,CENTR,J2,R3,R4,J,K,L,M
	DATA X/0.12/,Y/0.13/,Z/0.06/
CC      DATA X/1.2/,Y/1.3/
	CALL SETCUR(0,-300,0)
	IF(R2.NE.0)GO TO 20
CC      IF(R2.LT.99)GO TO 2
	CALL TYPSTR('<CR> SETS LOWER-LEFT POINT')
	ACCEPT 30,L
	CALL RDCUR(JA,J2)
	CALL TYPSTR('<CR> SETS UPPER-RIGHT POINT')
	ACCEPT 30,L
	CALL RDCUR(J,K)
	L=J-JA
	M=K-J2
	IF(L.GE.M)GO TO 10
C ADD AND SUBTR. X COORDS. (MAKE THEM SAME DIST. AS Y'S)
	M=(M-L)/2
	J=J+M
	JA=JA-M
10	L=J-JA
	R2=950.0/L
	JA=JA+L/2
	J2=J2+(K-J2)/2
	GO TO 40
20	CALL TYPSTR('<CR> SETS CENTER')
	ACCEPT 30,L
30	FORMAT(I)
	CALL RDCUR(JA,J2)
40	CALL CLRCUR
	R3=JA*X+50.0
	R4=J2*Y+52.0
	K=0
C  (K IS R6) ↑↑↑↑↑ SO NUMS ON SPACING SCALE WILL PRINT.
	END

	SUBROUTINE HELP(K)
	IMPLICIT INTEGER(A-Z)
	DIMENSION CDNUM(9)
	COMMON /DL/X22  /RRJJ/R(21),JJA /JCHAR/A,B,IBLA /RINP/I(16,8)
	1 /NUM/NUM(1)
	DATA CDNUM/'10','11','12','13','14','15','16','17','18'/
	L=-2
C -2=DO LOOKUP ON MSS,MUS (HELP FILES 1→18.DMD)
	IF(K.NE.IBLA)GO TO 10
	IF(X22.EQ.0)RETURN
C USE CURRENT CODE NUMBER IF IN EDIT MODE
	K=NUM(JJA+1)
	IF(JJA.GT.9)K=CDNUM(JJA-9)
10	CALL GETFI2(K,L)
	IF(L.EQ.1)RETURN
C L=1=FILE NOT FOUND
	L=-190
	CALL TYPLOC(450,L)
20	CALL FASTI2(I,128)
	DO 40 K=1,8
	IF(I(1,K).EQ.999)GO TO 60
	DO 30 J=16,1,-1
30	IF(I(J,K).NE.' ')GO TO 40
	J=1
40	TYPE 50,(I(L,K),L=1,J)
	GO TO 20
50	FORMAT(1X16A5/)
60	CALL TYPCRLF
	END

	SUBROUTINE ORDER
	IMPLICIT INTEGER(A-Q,S-Z)
	COMMON R2 /LIMIT/LIMIT,ITEM /ALF/I1
	1  /PTR/PWDS(1) /XRN/RN(1) /DPY/RST(1)  /DPTR/WDS(1)

	J=1
CC      J=4
C J=4 SO FRONT OF DPY BUFFER IS UNTOUCHED.
	JJ=1
	DO 40 K=0,7
10	M=0
	RX=9999.
	DO 20 L=1,ITEM
	N=PWDS(L)
	IF(R2.EQ.0.AND.K.NE.RN(N+2))GO TO 20
C R2.EQ.0 = ORDER BY STAVES     .NE.0 =ORDER ALL LEFT TO RIGHT
	R=RN(N+3)
	IF(R.EQ.10000.)GO TO 20
C SKIP ITEM THAT WAS ALREADY SHUFFLED
	IF(RN(N+1).EQ.16)GO TO 30
C DO NOT ORDER TEXT. (CODE 16)
	IF(R.GE.RX)GO TO 20
	RX=R
	M=L
20	CONTINUE
	IF(M.EQ.0)GO TO 40
C FOUND NO MORE ON THIS LINE
	L=M
30	WDS(JJ)=J
	JJ=JJ+1
C NOW PUT AWAY NEXT ITEM IN ORDER
CC      DO 3 MM=PWDS(L),PWDS(L+1)-1
CC      RST(J)=RN(MM)
CC3     J=J+1
	MM=PWDS(L+1)-PWDS(L)
C NEXT MOVES RN INTO RST
	CALL RLOOP(RST(J),RN(PWDS(L)),MM)
	J=J+MM
	RN(PWDS(L)+3)=10000.
C WIPE OUT THIS POSITION
	GO TO 10
40	CONTINUE
CC      DO 5 K=2,ITEM
C NOW FIX UP POINTER ARRAY AGAIN
CC5     PWDS(K)=WDS(K)-3
C                    BECAUSE JJ STARTED AT =4
	CALL RLOOP(PWDS,WDS,ITEM)
C PUTS WDS INTO PWDS
CC      DO 6 K=1,PWDS(ITEM+1)
C AND RN ARRAY
CC6     RN(K)=RST(K+3)
	CALL RLOOP(RN,RST,PWDS(ITEM+1))
C PUT RST BACK INTO RN
C SINCE DPY BUFFER WAS WIPED OUT, NOW DO A 'Z1' TO FIX IT UP.
	I1='Z'
	R2=1
	CALL DPYX
	END

	SUBROUTINE DPYX
C DOES COMPLETE DPY SETUP
	COMMON /DPY/ST(1)
	CALL DPYSET(1,ST,4000)
	CALL HYDPOG(2)
	CALL HYDPOG(1)
CC	CALL TYPLOC(450,0)
	CALL DPYBRT(5)
	END

	SUBROUTINE FILX(K)
C CHECKS TO SEE IF SOS OR ET FILE.  IF SOS, REWRITES IT SANS #S.
	COMMON /ALF/I(72) /JCHAR/IXX,ISEMI,IBLA /A2Z/AA,BB,LCC,
	1 DD,EE,FF,GG,LHH,LII,LJJ,LKK,LEL,LMM,LNN,LOH /NUM/NZERO
	CALL IFILE(1,K)
	READ(1,50)I
	IF(I(1).EQ.NZERO)GO TO 70
CXX **** FIX AT IRCAM 1/80 *****	IF(I(1).NE.LCC.AND.I(2).NE.LOH)GO TO 30
	IF(I(1).NE.LCC.OR.I(2).NE.LOH)GO TO 30
C IF 1ST CHAR. IS ZERO, ASSUME IT'S AN SOS FILE
C  ASSUMES 'COMMENT' IF 1ST 2 CHARS ARE C AND O.
20	READ(1,50)I
	IF(I(3).NE.ISEMI)GO TO 20
C GET RID OF HEADER.
	READ(1,50)I
C ONCE AGAIN!!
	RETURN
30	READ(1,50,END=40)I
	GO TO 30
C CLEAN EVERYTHING OUT.
40	CALL IFILE(1,K)
	RETURN
50	FORMAT(72A1)
60	FORMAT(I,72A1)
70	K='FOR21'
	CALL OFILE(21,K)
	REREAD 60,L,I
	CALL TYPSTR('SOS FILE COPIED TO FOR21.DAT')
	CALL TYPCRLF
	GO TO 90
80	READ(1,60,END=100)L,I
90	WRITE(21,50)I
	GO TO 80
100	END FILE 21
	GO TO 40
	END
 
 	SUBROUTINE RREAD(I,V)
C TAKES ASCII INPUT (INP) STRING, SEPARATES LETTERS FROM NUMBERS.
C MAKES ALL NUMBS FLTING PT.  FILLS UP END OF ARRAY WITH ZEROS.
C SENDS BACK IN V ARRAY. 
C E.G. 'GET FOO 4.55'  SENDS BACK V1=0, V2=0, V3=4.55, V4=0, ETC.
 	DIMENSION I(1),V(1)
 	EQUIVALENCE (N,RN)
 	DO 62 J=1,50
C ZERO V AND IV ARRAYS.****** 50 IS DIMENSION GIVEN IN MARKZ,BEAMS,SLURZ *********
 62	V(J)=0
 	DO 6  LEND=71,1,-1
 6	IF(I(LEND).NE.' ')GO TO 7
C LEND=END OF CHARS.	STARTS WITH NEXT-TO-LAST (LAST IS *)
 	RETURN 
9	IF(LETR.EQ.0)M=M+1
	LETR=-1
	GO TO 16
 7	M=1
 	J=1
	LETR=0
 8	N=I(J)
 	CALL LO2UP(N)
 	IF(N.NE.' '.AND.N.NE.'/')GO TO 11
C IGNORES BLANKS AND SLASHES
	LETR=0
	GO TO 16
11	IF(N.EQ.'-')GO TO 16
C IGNORE '-' (BUT LOOK IN NUMZ TO SEE IF JUST BEFORE A NUM.)
C 	IF(N.NE.'-'.AND.
C 	1 N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
CRR***	IF( N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
 	IF( N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 9
C NOW IT'S A NUMBER
 20	CALL NUMZ(KK,I(J),V(M))
 	J=J+KK-1
 10	M=M+1
 16	J=J+1
 	IF(J.LE.LEND)GO TO 8 
 	END
 
 	SUBROUTINE NUMZ(KK,I,X)
 	DIMENSION I(1)
 	DATA IZERO/'0'/,ININE/'9'/
 	J=-1
 	M=0
 	XMINUS=1.
	IF(I(0).EQ.'-')XMINUS=-XMINUS
C  I(0) MIGHT NOT WORK WITH SOME FORTRANS!!
 	DO 21 KK=1,15
C IS 15 ENOUGH?  YES, WILL DO ONLY 8 DIGITS PLUS DECI.PT.
 	IX=I(KK)
 	IF(IX.GE.IZERO.AND.IX.LE.ININE)GO TO 22
C 	IF(IX.EQ.'-')GO TO 24
 	IF(IX.NE.'.')GO TO 20
 	J=KK
 	GO TO 21
C  24	XMINUS=-XMINUS
C 	GO TO 21
 22	N=(IX-IZERO)/536870912
 	M=N+M*10
 21	CONTINUE
 20	IF(J.LT.0)GO TO 23
 	X=KK-J-1
 	X=XMINUS*M/(10.**X)
 	RETURN
 23	X=XMINUS*M
C FOR NO DECI.
 	END
 
C**IRCAM** 	SUBROUTINE NUMLTR(L,J)
C**IRCAM**C THIS, AND ABOVE ROUTINES, TAKES CARE OF STANFORD 'REREAD' FEATURE
C**IRCAM**C 'RREAD' IS CALLED JUST AFTER ORIGINAL READ STATEMENT
C**IRCAM** 	COMMON R2,JA,CEN,J2,RJQ(20)  /SCM/V(22)
C**IRCAM** 	J=V(1)
C**IRCAM** 	N=L+1
C**IRCAM** 	R2=V(N)
C**IRCAM** 	DO 1 K=1,20
C**IRCAM** 1	RJQ(K)=V(K+N)
C**IRCAM** 	END